home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / H108.ZIP / SETPORT.ZIP / SETPORT.LSP < prev   
Lisp/Scheme  |  1991-09-29  |  3KB  |  97 lines
  1. ;  This routine will take a lot of the grief out of creating,sizing 
  2. ;  and displaying viewports in pspace.  Many thanks to John Barton
  3. ;  for adding the ability to drag a box around when placing the viewport.
  4. ;
  5. ;                                                  Gary Kessel
  6. ;                                                  901-526-9600 
  7. ;                                                  76447,1020
  8. ;
  9. (defun c:SETPORT ()
  10.     (setvar "tilemode" 1)
  11. ;get world coordinates
  12.     (setq ll (getpoint "\nPick lower left corner: ")
  13.           ur (getcorner "\nPick upper right corner: " ll ))
  14.     (setq x1 (car ll))
  15.     (setq y1 (cadr ll))
  16.         (setq x2 (car ur))
  17.         (setq y2 (cadr ur))
  18. ;  calc "real world" port size
  19.         (setq xdist (abs(- x1 x2)))
  20.         (setq ydist (abs(- y1 y2)))
  21. ;  get scale expressed as : 12 24 48 96 192 etc.
  22.     (setq vscale (getreal "\nScale for this view ?\n"))
  23. ;  calc pspace port size
  24.     (setq xpdist (/ xdist vscale))
  25.     (setq ypdist (/ ydist vscale))
  26. ;  calc inverse of scale
  27.     (setq vscale (/ 1 vscale))
  28. ;  get port name for recall and open .vpt file for saving info
  29.     (setq vname (strcat (getstring "\nName for this view ?\n") ".vpt"))
  30.     (setq file (open vname "w"))
  31. ;  write info to file and close
  32.     (write-line (rtos xpdist 2 10) file)
  33.     (write-line (rtos ypdist 2 10) file)
  34.         (write-line (rtos vscale 2 10) file)
  35.     (princ ll file)
  36.     (princ "\n" file)
  37.     (princ ur file)
  38.     (close file)
  39. )
  40. ;
  41. ;  The routine for recalling the port simply reads in the file info and
  42. ;  goes through a sequence that you might do manually.
  43. ;
  44. (defun c:GETPORT ()
  45.     (setq file (getstring "\nViewport to get ?\n"))
  46.     (setq file2 (open (strcat file ".vpt") "r"))
  47.     (setq xpdist (atof(read-line file2)))
  48.     (setq ypdist (atof(read-line file2)))
  49.     (setq vscale (atof(read-line file2)))
  50.     (setq ll (read-line file2))
  51.     (setq ll (read ll))
  52.     (setq ur (read-line file2))
  53.     (setq ur (read ur))
  54.     (close file2)
  55.     (setvar "tilemode" 0)
  56. (command "pspace")
  57. (setq start (setpoint ))
  58. (command "mview" start  (list (+ (car start) xpdist) (+ (cadr start) ypdist))) 
  59. (command "mspace")
  60. (command "zoom" "w" ll ur)
  61. (command "zoom" (strcat (rtos vscale 2 10) "xp"))
  62. (command "pspace")
  63. )
  64. ;  This is the routine for dragging a box around while placing the port in 
  65. ;  pspace.  The pick is a little sluggish at times but it will work.
  66. ;
  67. (defun grbox(ptx /)
  68.   (grdraw ptx (setq pt2 (polar ptx 0 xpdist)) -1)
  69.   (grdraw pt2 (setq pt3 (polar pt2 (* 0.5 pi) ypdist)) -1)
  70.   (grdraw pt3 (setq pt4 (polar ptx (* 0.5 pi) ypdist)) -1)
  71.   (grdraw pt4 ptx -1)
  72. )
  73. (defun setpoint ()
  74.   (prompt "\nPick point for lower left corner:\n")
  75.   (setq done 1)
  76.   (setq ptb (cadr (grread T)))
  77.   (grbox ptb)
  78.   (while done
  79.     (setq glist (grread T))
  80.     (setq pta ptb)
  81.     (setq ptb (cadr (grread T)))
  82.     (if (and (= (car glist) 5) (> (distance pta ptb) 0.03))
  83.      (progn
  84.      (grbox pta)
  85.      (grbox ptb)
  86.      )
  87.     )  
  88.     (if (= (car glist) 3)
  89.      (progn
  90.        (setq done nil)
  91.        (grbox pta)
  92.        (setq pt (cadr glist))
  93.      )
  94.     )
  95.   )
  96. )
  97.